home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / NEWSOFT / AUGUST / WORKDISC / !Forthmacs / spread / commands < prev    next >
Text File  |  1996-06-07  |  5KB  |  174 lines
  1. \ high-level commands
  2.  
  3. : quit_calc            \ exit spreadsheet
  4.     y/n            \ ask again to be sure
  5.     if    pos2 ." bye" previous previous
  6.         quit-spread
  7.     then  ;
  8.  
  9. variable marker
  10. : forget_to_mark        \ forget formulas
  11.     marker @ here - allot ;
  12.  
  13. : new                \ clear existing spreadsheet
  14.     y/n            \ ask again if yes clear it
  15.     if    0 0 spcells         
  16.         row_max col_max * 2* cells erase    \ erase cells array
  17.         0 row_names    \ erase row_name array
  18.         row_max row_name_len * erase  
  19.         0 col_names    \ erase col_name array
  20.         col_max col_name_len * erase  
  21.         forget_to_mark    \ erase all formulas
  22.         row_disp off
  23.         col_disp off    \ set marker to origin
  24.         p" noname" application-name "copy
  25.         dis_screen    \ display cleared screen
  26.     then  ;
  27.  
  28. : mode                \ set auto-calculation mode
  29.     pos1 ." set auto-calculation mode"
  30.     pos2 ." normal=0 or auto=1: "
  31.     skey [char] 1 = mode_flag ! ;    \ set mode_flag accordingly
  32.  
  33. : perform_calc                \ force calculations
  34.     calc_cells  dis_data ;
  35.  
  36. : format                \ select a format
  37.     pos1 ." select input number format"
  38.     pos2 ." normal=0 or dollars/cents=1: "
  39.     skey [char] 1 = format_flag !
  40.     dis_data ;
  41. : input_application
  42.     pos1 ." Enter name of this spreadsheet"
  43.     pos2 application-name char+ 10 expect  span @ application-name c!
  44.     application-name count lower
  45.     dis_screen ;
  46.  
  47.  
  48. : again_repl                \ replicate column data
  49.     cell_ptr cell+ @        \ bring cell data to tos
  50.     pos1 ."  cell+column replicate cell data"
  51.     pos2 ."  cell+number of columns: "
  52.     #in ?dup cell+            \ get # of columns
  53.     if    0 cell+            \ if answer <> 0
  54.         do right_arrow        \ move right
  55.            dup cell_ptr cell+ !    \ and store data
  56.         loop
  57.         drop dis_data        \ display the new data
  58.     then ;                \ else ignore if col=0
  59.  
  60. : cur_col_max        ( -- n )
  61.     col_max cols/page -  ;
  62. : set_col        ( col# -- )
  63.     dup cur_col_max >  ( col# )
  64.     if    cur_col_max tuck -  ( cur_col col_disp )
  65.     else    0
  66.     then
  67.     col_disp !   cur_col ! ;
  68. : cur_row_max    ( -- n )
  69.     row_max rows/page -  ;
  70. : set_row    ( row# -- )
  71.     dup cur_row_max >  ( col# )
  72.     if    cur_row_max tuck -  ( cur_col col_disp )
  73.     else    0
  74.     then
  75.     row_disp !   cur_row ! ;
  76. variable new_row
  77. variable new_col
  78.  
  79. : do_go_to  ( row column -- )
  80.     0 max  col_max 1- min  new_col !
  81.     0 max  row_max 1- min  new_row !
  82.     new_row @  row     dup rows/page +  within
  83.     new_col @  column  dup cols/page +  within and
  84.     if        \ Target is on screen; just move marker
  85.         erase_cell_marker
  86.         new_row @  row    -  row_disp !
  87.         new_col @  column -  col_disp !
  88.         place_cell_marker
  89.         exit
  90.     then
  91.     new_row @ row  dup rows/page +  within
  92.     if        \ Row is on screen; redisplay columns
  93.         erase_cell_marker
  94.         new_row @  row    -  row_disp !
  95.         new_col @  set_col
  96.         dis_col_change
  97.         place_cell_marker
  98.         exit
  99.     then
  100.     new_col @  column  dup cols/page +  within
  101.     if        \ Column is on screen; redisplay rows
  102.         erase_cell_marker
  103.         new_row @  set_row
  104.         new_col @  column -  col_disp !
  105.         dis_row_change
  106.         place_cell_marker
  107.         exit
  108.     then
  109.     \ Target is off screen; reframe the whole show
  110.     erase_cell_marker
  111.     new_row @ set_row
  112.     new_col @ set_col
  113.     dis_row_names
  114.     dis_row_labels
  115.     dis_col_names
  116.     dis_col_labels
  117.     dis_data
  118.     place_cell_marker ;
  119. : go_to                    \ go to specified row/col
  120.     pos1 ." row(0-99): "        \ prompt for row #
  121.     #in dup 0 row_max within    \ check for proper range
  122.     if    ( row# )        \ if ok store it
  123.         pos2 ." column(a-z): "    \ prompt for col # (a-z)
  124.         skey upc [char] A - dup    \ check for proper range
  125.         0 col_max within    \ if ok goto data window
  126.         if do_go_to else 2drop then
  127.     else    drop
  128.     then  ;
  129.  
  130. : the_row    ( -- row# )    row     row-disp +  ;
  131. : the_col    ( -- col# )    column  col-disp +  ;
  132.  
  133. : first_col    the_row 0 do_go_to  ;
  134. : last_col    the_row col_max 1-  do_go_to  ;
  135. : top_row    0 the_col do_go_to  ;
  136. : bottom_row    row_max 1- the_col  do_go_to  ;
  137. : left_page    the_row the_col cols/page -  do_go_to  ;
  138. : right_page    the_row the_col cols/page +  do_go_to  ;
  139. : down_page    the_row rows/page +  the_col do_go_to  ;
  140. : up_page    the_row rows/page -  the_col do_go_to  ;
  141.  
  142. \ operator input processing
  143.  
  144. decimal
  145. : dispatch    ( key -- )
  146.     case
  147.         [char] A of again_repl        endof
  148.         [char] C of input_col_names    endof
  149.         [char] D of input_cell_data    endof
  150.         [char] E of input_equ        endof
  151.         [char] F of format        endof
  152.         [char] G of go_to        endof
  153.         [char] M of mode        endof
  154.         [char] N of new            endof
  155.         [char] O of calc_order        endof
  156.         [char] P of perform_calc    endof
  157.         [char] Q of quit_calc        endof
  158.         [char] R of input_row_names    endof
  159.         [char] S of input_application    endof
  160.         control B of left_arrow        endof
  161.         control F of right_arrow    endof
  162.         control N of down_arrow        endof
  163.         control P of up_arrow        endof
  164.         control A of first_col        endof
  165.         control E of last_col        endof
  166.         control Y of left_page        endof
  167.         control U of right_page        endof
  168.         control V of down_page        endof
  169.         control T of up_page        endof
  170.         control L of perform_calc    endof
  171.         control Z of quit_calc        endof
  172.         beep
  173.     endcase ;
  174.